/* Guile-GCC
   Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>

   This file is part of Guile-GCC.

   Guile-GCC is free software: you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation, either version 3 of the License, or
   (at your option) any later version.

   Guile-GCC is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with Guile-GCC.  If not, see <http://www.gnu.org/licenses/>.  */

#include <ggcc-config.h>

int plugin_is_GPL_compatible;

/* #define ENABLE_TREE_CHECKING 1 */

#include <gcc-plugin.h>
#include <plugin-version.h>

#include <plugin.h>
#include <cpplib.h>
#include <tree.h>
#include <tree-pass.h>
#include <tree-iterator.h>

#include <stdio.h>
#include <string.h>

#include <libguile.h>
#include <ggcc-utils.h>

/* Produce a raw wrapper around tree accessor NAME that takes an FFI pointer
   and returns NAME's return wrapped with TO_SCM.  */

#define MAKE_TREE_ACCESSOR(name, to_scm)				\
  SCM_DEFINE (ggcc_tree_ ## name, STRINGIFY (name), 1, 0, 0,		\
	      (SCM pointer),						\
	      "Return the " STRINGIFY (name) " of @var{pointer}.")	\
  {									\
    return to_scm (name ((tree) SCM_POINTER_VALUE (pointer)));		\
  }

MAKE_TREE_ACCESSOR (TREE_CODE, scm_from_int)
MAKE_TREE_ACCESSOR (TREE_TYPE, ggcc_from_pointer)
MAKE_TREE_ACCESSOR (DECL_NAME, ggcc_from_pointer)
MAKE_TREE_ACCESSOR (DECL_SOURCE_LOCATION, scm_from_long)
MAKE_TREE_ACCESSOR (IDENTIFIER_POINTER, ggcc_from_pointer)
MAKE_TREE_ACCESSOR (TREE_STRING_POINTER, ggcc_from_pointer)
MAKE_TREE_ACCESSOR (TYPE_FIELDS, ggcc_from_pointer)
MAKE_TREE_ACCESSOR (TREE_VALUE, ggcc_from_pointer)
MAKE_TREE_ACCESSOR (TREE_PURPOSE, ggcc_from_pointer)
MAKE_TREE_ACCESSOR (TREE_CHAIN, ggcc_from_pointer)
MAKE_TREE_ACCESSOR (DECL_FIELD_OFFSET, ggcc_from_pointer)

#define MAKE_TREE_PREDICATE(name)		\
  MAKE_TREE_ACCESSOR (name, scm_from_bool)

MAKE_TREE_PREDICATE (TYPE_P)
MAKE_TREE_PREDICATE (DECL_P)
MAKE_TREE_PREDICATE (INTEGRAL_TYPE_P)
MAKE_TREE_PREDICATE (POINTER_TYPE_P)
MAKE_TREE_PREDICATE (RECORD_OR_UNION_TYPE_P)
MAKE_TREE_PREDICATE (TREE_SIDE_EFFECTS)

/* Produce a raw setter to set the NAME of a tree, where both TREE and VALUE
   are FFI pointer objects.  */

#define MAKE_TREE_SETTER(name, from_scm)				\
  SCM_DEFINE (ggcc_tree_set_ ## name, "SET_" STRINGIFY (name), 2, 0, 0,	\
	      (SCM pointer, SCM value),					\
	      "Set the " STRINGIFY (name) " of @var{pointer} to @var{value}.") \
  {									\
    name ((tree) SCM_POINTER_VALUE (pointer)) = from_scm (value);	\
    return SCM_UNSPECIFIED;						\
  }

MAKE_TREE_SETTER (TREE_SIDE_EFFECTS, scm_to_bool)


/* Procedures for cpplib.  */


/* Return the type of the token pointed to by POINTER.  */

static SCM
ggcc_cpp_token_type (SCM pointer)
{
  struct cpp_token *t = SCM_POINTER_VALUE (pointer);

  return scm_from_int (t->type);
}

/* Return the source location of the token pointed to by POINTER.  */

static SCM
ggcc_cpp_token_source_location (SCM pointer)
{
  struct cpp_token *t = SCM_POINTER_VALUE (pointer);

  return scm_from_int (t->src_loc);
}


/* Passes.  */

SCM_DEFINE (ggcc_make_pass, "%make-pass", 3, 0, 0,
	    (SCM name, SCM type, SCM handler),
	    "Return a pointer object to a new pass.")
{
  struct opt_pass *p;

  p = scm_gc_malloc (sizeof *p, "gcc");
  memset (p, 0, sizeof *p);

  p->type = scm_to_int (type);
  p->name = scm_gc_strdup (SCM_POINTER_VALUE (name), "gcc");
  p->execute = SCM_POINTER_VALUE (handler);

  return scm_from_pointer (p, NULL);
}

#define MAKE_PASS_ACCESSOR(field, to_scm)				\
  SCM_DEFINE (ggcc_pass_ ## field, "%pass-" STRINGIFY (field), 1, 0, 0,	\
	      (SCM pointer),						\
	      "Return the " STRINGIFY (field) " of the pass pointed to " \
	      "by @var{pointer}.")					\
  {									\
    const struct opt_pass *p;						\
    p = SCM_POINTER_VALUE (pointer);					\
    return to_scm (p->field);						\
  }

MAKE_PASS_ACCESSOR (name, scm_from_locale_string)
MAKE_PASS_ACCESSOR (type, scm_from_int)
MAKE_PASS_ACCESSOR (execute, ggcc_from_pointer)

#define MAKE_PASS_CONSTANT(name)					\
  SCM_VARIABLE_INIT (ggcc_ ## name, STRINGIFY (name), scm_from_int (name));

MAKE_PASS_CONSTANT (PASS_POS_INSERT_AFTER)
MAKE_PASS_CONSTANT (PASS_POS_INSERT_BEFORE)
MAKE_PASS_CONSTANT (PASS_POS_REPLACE)

MAKE_PASS_CONSTANT (GIMPLE_PASS)
MAKE_PASS_CONSTANT (RTL_PASS)
MAKE_PASS_CONSTANT (SIMPLE_IPA_PASS)
MAKE_PASS_CONSTANT (IPA_PASS)


int
plugin_init (struct plugin_name_args *plugin_info,
	     struct plugin_gcc_version *version)
{
  if (!plugin_default_version_check (version, &gcc_version))
    return 1;

  /* Return whatever was passed as the `-fplugin-arg-guile-module-directory'
     argument.  */
  const char *command_line_guile_dir (void)
  {
    size_t arg;

    for (arg = 0; arg < plugin_info->argc; arg++)
      {
	if (strcmp (plugin_info->argv[arg].key, "module-directory") == 0)
	  return plugin_info->argv[arg].value;
      }

    return NULL;
  }

  /* Return the plug-in arguments as a list of key/value pairs.  */
  SCM plugin_arguments (void)
  {
    SCM lst;
    size_t arg;

    for (arg = 0, lst = SCM_EOL; arg < plugin_info->argc; arg++)
      {
	SCM p;
	const char *val;

	val = plugin_info->argv[arg].value;
	p = scm_cons (scm_from_locale_string (plugin_info->argv[arg].key),
		      val == NULL ? SCM_BOOL_F : scm_from_locale_string (val));
	lst = scm_cons (p, lst);
      }

    return scm_reverse (lst);
  }

  void define_gcc_module (void *unused)
  {
    #include "guile.x"

    #define DEFTREECODE(SYM, NAME, TYPE, LENGTH)		\
      scm_define (scm_from_latin1_symbol (STRINGIFY (SYM)),	\
		  scm_from_int (SYM));
    #include "tree.def"
    #undef DEFTREECODE

    #define DEFEVENT(EVENT)					\
      scm_define (scm_from_latin1_symbol (STRINGIFY (EVENT)),	\
                  scm_from_int (EVENT));
    #include "plugin.def"
    #undef DEFEVENT

    #define DEF_BUILTIN(ENUM, NAME, CLASS, TYPE, LIBTYPE, BOTH_P,	\
		        FALLBACK_P, NONANSI_P, ATTRS, IMPLICIT, COND)	\
      scm_define (scm_from_latin1_symbol (STRINGIFY (ENUM)),		\
		  scm_from_int (ENUM));
    #include "builtins.def"
    #undef DEF_BUILTIN

    scm_c_define ("%plugin-arguments", plugin_arguments ());
  }

  void define_cpp_module (void *unused)
  {
    #ifdef TTYPE_TABLE
    /* Get the token types from the `TTYPE_TABLE' macro in <cpplib.h>.  */
    # define TK(e, s)							\
        scm_define (scm_from_latin1_symbol ("CPP_" STRINGIFY (e)),	\
                    scm_from_int (CPP_ ## e));
    # define OP(e, s) TK(e, s)
    # undef EOF				       /* So that we get CPP_EOF.  */
    TTYPE_TABLE
    # undef OP
    # undef TK
    #else
    # error TTYPE_TABLE is undefined
    #endif

    scm_c_define_gsubr ("%token-type", 1, 0, 0, ggcc_cpp_token_type);
    scm_c_define_gsubr ("%token-source-location", 1, 0, 0,
			ggcc_cpp_token_source_location);
  }

  /* Enter Guile!  */
  scm_init_guile ();

  /* Define the (gcc) module, with subr definitions.  */
  scm_c_define_module ("gcc", define_gcc_module, NULL);

  /* Define the (gcc cpp internal) module, with constant definitions.  */
  scm_c_define_module ("gcc cpp internal", define_cpp_module, NULL);

  /* Bootstrap the Guile code.  */
  const char *guile_dir = command_line_guile_dir ();
  if (guile_dir == NULL)
    {
      getenv ("GUILE_GCC_MODULE_DIRECTORY");
      if (guile_dir == NULL)
	guile_dir = GGCC_MODULE_DIRECTORY;
    }

  char file_name[strlen (guile_dir) + 8];
  strcpy (file_name, guile_dir);
  strcat (file_name, "/gcc.scm");

  /* Add GUILE_DIR to the front of the search path.  */
  SCM load_path_var = scm_c_lookup ("%load-path");
  scm_variable_set_x (load_path_var,
		      scm_cons (scm_from_locale_string (guile_dir),
				scm_variable_ref (load_path_var)));

  scm_c_primitive_load (file_name);

  return 0;
}
